home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_oth / bastoftn / basconv.bas next >
BASIC Source File  |  1985-06-01  |  19KB  |  453 lines
  1. 1000 DEFINT A-Z
  2. 1050 DEF FNUM(Q$)=ASC(LEFT$(Q$,1))>47 AND ASC(LEFT$(Q$,1))<58
  3. 1100 DEF FNTOGGLE(X$,Y$,FLG)=FLG XOR X$=Y$
  4. 1150 DEF FNREP$(X$,Y$,A,B)=LEFT$(X$,A-1)+Y$+MID$(X$,B)
  5. 1200 DEF FNINS$(X$,Y$,A,B)=LEFT$(X$,A)+Y$+MID$(X$,B)
  6. 1250 TST$(1)="$":TST$(2)="%":TST$(3)="#":TST$(4)="!"
  7. 1300 DIM REFLIN!(500),REFER!(500),VALPH$(200),VINT$(200),VDBL$(200),VSNGL$(200)
  8. 1350 DIM POINT4!(200,2),STACK4(25),CSTK$(25),TOKLST$(20),PTLST(20),AA(20),BB(20)
  9. 1400 DATA " ","(",")","^","*","-","+","=","<",">"
  10. 1450 RESTORE 1400:FOR I=1 TO 10:READ DELIM$(I):NEXT
  11. 1500 QUOTE$=CHR$(34):BLANK$=CHR$(32):COLON$=":"
  12. 1550 NEXTLIN!=0
  13. 1600 NN=71
  14. 1601 KEY OFF
  15. 1650 IREF=0:JREF=0:IINT=0:IALPH=0:IDBL=0:ISNGL=0
  16. 1700 TRUE=-1:FALSE=0:PT4=0
  17. 1750 IMPFLG=FALSE:XORFLG=FALSE:EQVFLG=FALSE
  18. 1800 REM
  19. 1850 DIM KFOR$(80),PNTR(1150)
  20. 1900 DIM KBAS$(80),HASH(80),TWOS(6)
  21. 1950 DIM BUF$(10),CP(10)
  22. 2000 DATA ABS,AND,ASC,ATN,BEEP,CDBL,CHR$,CINT,CLOSE,CLS,COMMON
  23. 2050 DATA COS,CSNG,DATA,DEF,DEFSNG,DEFDBL,DEFINT,DEFSTR,DIM,ELSE,END
  24. 2100 DATA EOF,EQV,EXP,FIX,FN,FOR,GOSUB,GOTO,IF,IMP,INKEY$,INPUT
  25. 2150 DATA INPUT#,INPUT$,INT,LET,LOG,LPRINT,MOD,NEXT,NOT,ON,OPEN,OPTION
  26. 2200 DATA OR,PRINT,PRINT#,READ,REM,RESTORE,RETURN,SGN,SIN,SPACE$
  27. 2250 DATA SPC(,SQR,STEP,STOP,SWAP,TAN,THEN,then,TO,USING,WEND,WHILE,WRITE
  28. 2300 DATA WRITE#,XOR
  29. 2350 REM unhandled:data,gosub,inkey$,input$,option,read,restore,space$,spc(
  30. 2400 REM
  31. 2450 DATA 1,2,4,8,16,32
  32. 2500 REM
  33. 2550 REM
  34. 2600 DATA ABS,.AND.,ICHAR,ATAN,*,DBLE,CHAR,ANINT,CLOSE(,*,COMMON
  35. 2650 DATA COS,SNGL,DATA,*,IMPLICIT REAL (,IMPLICIT REAL*8 ( ,IMPLICIT INTEGER ( ,CHARACTER*127,DIMENSION,ELSE,END
  36. 2700 DATA EOF,*,EXP,IFIX,*,DO,CALL,GOTO,IF(,*,*,"READ(*,*)"
  37. 2750 DATA "READ(*,*)",READ,INT,*,ALOG,"WRITE(6,*)",MOD,CONTINUE,.NOT.,ON,OPEN,*
  38. 2800 DATA .OR.,"WRITE(*,*)",WRITE,*,C,*,RETURN,SIGN,SIN,*
  39. 2850 DATA *,SQRT,",",STOP,*,TAN,],] THEN,",",",",*,CONTINUE,"WRITE(*,*)",WRITE,*
  40. 2900 REM
  41. 2950 RESTORE 2000
  42. 3000 FOR I=1 TO NN:READ A$:KBAS$(I)=SPACE$(8):LSET KBAS$(I)=A$:NEXT
  43. 3050 RESTORE 2450:FOR I=1 TO 6:READ TWOS(I):NEXT
  44. 3100 RESTORE 2600:FOR I=1 TO NN:READ A$:KFOR$(I)=A$:NEXT
  45. 3150 FOR I=1 TO NN
  46. 3200 TOKEN$=KBAS$(I)
  47. 3250 GOSUB 6900
  48. 3300 HASH(I)=S
  49. 3350 IF PNTR(HASH(I))=0 THEN PNTR(HASH(I))=I
  50. 3400 NEXT I
  51. 3450 PRINT"Enter name of BASIC   Program ";:INPUT F$
  52. 3500 OPEN F$ FOR INPUT AS #1
  53. 3550 PRINT "Enter name of FORTRAN Program ";:INPUT G$
  54. 3600 OPEN G$ FOR OUTPUT AS #2
  55. 3650 PRINT "Do you wish to have source displayed? ";:INPUT ANS$
  56. 3700 PRINT
  57. 3750 IF LEFT$(ANS$,1)="Y" OR LEFT$(ANS$,1)="y" THEN SHOW=TRUE ELSE SHOW=FALSE
  58. 3800 IF SHOW THEN CLS
  59. 3850 ON ERROR GOTO 6850
  60. 3900 H$="c:WORK":OPEN H$ FOR OUTPUT AS #3: GOTO 4000
  61. 3950 H$="b:WORK":OPEN H$ FOR OUTPUT AS #3
  62. 4000 ON ERROR GOTO 0
  63. 4001 OLIN=0
  64. 4002 LOCATE 2,50:COLOR 5,0:PRINT"PASS 1: PARSING"
  65. 4050 FOR Z!=1 TO 1000000!
  66. 4051 LINE INPUT#1,BUF$(0)
  67. 4100 IF EOF(1) THEN 6101
  68. 4150 IF INSTR(BUF$(0),"XOR")<>0 THEN XORFLG=TRUE
  69. 4200 IF INSTR(BUF$(0),"IMP")<>0 THEN IMPFLG=TRUE
  70. 4250 IF INSTR(BUF$(0),"EQV")<>0 THEN EQVFLG=TRUE
  71. 4350 FC=INSTR(1,BUF$(0),BLANK$)+1
  72. 4400 I=1:LLINES=1:OLIN=OLIN+1:QUOTFLG=FALSE
  73. 4450 CM=0
  74. 4500 REM
  75. 4550 REM fix ELSEs
  76. 4600 REM
  77. 4650 GOSUB 7800:L=LEN(BUF$(0))
  78. 4690 KP=P:P=0
  79. 4700 FOR J=I TO L:X$=MID$(BUF$(0),J,1):QUOTFLG=FNTOGGLE(X$,QUOTE$,QUOTFLG):          IF (NOT QUOTFLG) AND X$=":" THEN P=J:GOTO 4751
  80. 4750 NEXT J
  81. 4751 REM
  82. 4800 IF P=0 THEN P=(INSTR(KP+1,BUF$(0),"'")):IF P>0 THEN CM=LLINES
  83. 4850 IF P>0 THEN CP(LLINES)=P:LLINES=LLINES+1:OLIN=OLIN+1:I=P+1-(CM<>0):GOTO         4690 ELSE GOTO      4900
  84. 4900 CP(LLINES)=L+1:CP(0)=0
  85. 4950 REM
  86. 5000 FOR M=LLINES TO 1 STEP-1
  87. 5005 CC=CM=(M-1) AND M>1
  88. 5050 BUF$(M)=MID$(BUF$(0),CP(M-1)+1+(CC),CP(M)-CP(M-1)-1-(CC))
  89. 5100 NEXT
  90. 5150 LINEO!=VAL(BUF$(1)):IF LINEO!<=NEXTLIN! THEN PRINT"ERROR--not enough space to insert logical lines":BEEP:STOP
  91. 5200 IF LLINES<2 THEN 5300
  92. 5250 FOR K=2 TO LLINES:NEXTLIN!=LINEO!-1+K:L$=STRING$(5," "):BUF$(K)=L$+BLANK$       +BUF$(K):NEXT
  93. 5300 IF FC=7 THEN 5351
  94. 5350 BUF$(1)=LEFT$(BUF$(1),FC-1)+" "+MID$(BUF$(1),FC):FC=FC+1:GOTO 5300
  95. 5351 FOR M=1 TO LLINES
  96. 5352 IF MID$(BUF$(M),FC,1)=" " THEN BUF$(M)=LEFT$(BUF$(M),FC-1)+MID$(BUF$(M),FC+1):GOTO 5352
  97. 5353 NEXT M
  98. 5400 RMFLG=FALSE
  99. 5450 FOR I=1 TO LLINES 'for each logical line...
  100. 5500 IF MID$(BUF$(1),FC,3)="REM" OR MID$(BUF$(1),FC,1)="'" THEN RMFLG=TRUE
  101. 5550 IF (NOT RMFLG) AND MID$(BUF$(I),FC,1)="'" THEN BUF$(I)="C"+BUF$(I)
  102. 5600 IF RMFLG THEN BUF$(I)="C"+BUF$(I)
  103. 5650 NEXT
  104. 5700 IF RMFLG THEN 5950
  105. 5750 ON ERROR GOTO 13000
  106. 5800 GOSUB 8300 'BUILD TABLE OF REFERENCED LINES
  107. 5850 GOSUB 9500 'BUILD TABLE OF CHAR, INT, AND DBL VARS [SINGLE NOT DETECTABLE]
  108. 5900 GOSUB 11950 'BUILD FOR/NEXT REF TABLE
  109. 5950 FOR I=1 TO LLINES:PRINT#3,BUF$(I)
  110. 6000 IF SHOW THEN COLOR 3,1:PRINT BUF$(I):COLOR 7,0
  111. 6050 BUF$(I)="":NEXT I
  112. 6100 NEXT Z!
  113. 6101 GOSUB 30000
  114. 6150 CLOSE 1:CLOSE 3:OPEN H$ FOR INPUT AS #1
  115. 6200 IF SP<>0 THEN ERROR 82
  116. 6250 IF SHOW THEN PRINT
  117. 6300 LOCATE 2,50:COLOR 3,0:PRINT"PASS 2: EDITING "
  118. 6350 GOSUB 13200 'VAR DEFS
  119. 6351 LOUT=0
  120. 6400 WHILE NOT EOF(1)
  121. 6450 LINE INPUT#1,BUF$(0)
  122. 6451 LOUT=LOUT+1
  123. 6452 IF OLIN>20 AND (LOUT MOD 20)=0 OR LOUT=1 THEN CLS:GOSUB 30000:LOCATE 2,50:      COLOR 3,0:PRINT     "PASS 2: EDITING "
  124. 6500 FS=INSTR(BUF$(0)," "):LINEO!=VAL(LEFT$(BUF$(0),FS)):L$=MID$(STR$(LINEO!),2)
  125. 6550 X$=STRING$(6," "):IF LEFT$(BUF$(0),1)<>"C" THEN MID$(BUF$(0),1,6)=X$
  126. 6600 GOSUB 14350:GOSUB 21150:PRINT#2,BUF$(0)
  127. 6650 IF SHOW THEN COLOR 1,3:PRINT BUF$(0):COLOR 7,0
  128. 6700 WEND
  129. 6750 REM
  130. 6800 END
  131. 6850 RESUME 3950
  132. 6900 S=0
  133. 6950 FOR J=8 TO 1 STEP -1
  134. 7000 ZL=J
  135. 7050 W$=MID$(TOKEN$,J,1):IF W$<>" " THEN 7150
  136. 7100 NEXT J
  137. 7150 IF ZL>6 THEN ZL=6
  138. 7200 FOR J=1 TO ZL
  139. 7250 W$=MID$(TOKEN$,J,1):X=ASC(W$)-64
  140. 7300 S=S+X*TWOS(ZL-J+1)
  141. 7350 NEXT J
  142. 7400 S=S-23:IF S<0 OR S>1134 THEN S=0
  143. 7450 REM RESOLVE COLLISIONS
  144. 7500 IF TOKEN$="EOF     " THEN S=78:RETURN
  145. 7550 IF TOKEN$="SIN     " THEN S=79:RETURN
  146. 7600 IF TOKEN$="TO      " THEN S=80:RETURN
  147. 7650 IF TOKEN$="IMP     " THEN S=77:RETURN
  148. 7700 IF TOKEN$="INT     " THEN S=76:RETURN
  149. 7750 RETURN
  150. 7800 PE=FC:ELSC=0:IF INSTR(BUF$(0),"ELSE")=0 THEN RETURN
  151. 7850 ELSP=INSTR(PE,BUF$(0),"ELSE"):IF ELSP=0 THEN 8150
  152. 7900 ELSC=ELSC+1:ND=ELSP+4
  153. 7950 IF FNUM(MID$(BUF$(0),ND+1,1)) THEN BUF$(0)=FNINS$(BUF$(0),"GOTO ",ND,ND+1)
  154. 8000 BUF$(0)=FNINS$(BUF$(0),":",ELSP-1,ELSP):BUF$(0)=FNINS$(BUF$(0),":",ND,ND+1)
  155. 8050 IF INSTR(MID$(BUF$(0),PE,ELSP-PE),":")<>0 THEN BUF$(0)=FNINS$(BUF$(0),          ":ENDIF",ELSP-2,ELSP-1):ELSP=ELSP+6
  156. 8100 PE=ELSP+2:GOTO 7850
  157. 8150 FOR K=1 TO ELSC:BUF$(0)=BUF$(0)+":ENDIF":NEXT
  158. 8200 IT=INSTR(BUF$(0),"THEN"):BUF$(0)=FNREP$(BUF$(0),"then",IT,IT+4):RETURN
  159. 8250 REM
  160. 8300 T=1:FOR I=1 TO LLINES
  161. 8350 T=1
  162. 8400 IF INSTR(MID$(BUF$(I),1),"ON ERROR")=0 THEN 8500
  163. 8450 BUF$(I)="C"+BUF$(I):GOTO 9400
  164. 8500 Q=INSTR(T,BUF$(I),"GOTO "):IF Q=0 THEN Q=INSTR(T,BUF$(I),"GOSUB ")
  165. 8550 IF Q=0 THEN Q=INSTR(T,BUF$(I),"then ")
  166. 8600 IF Q<>0 THEN 9050
  167. 8650 T0=T:T=INSTR(T,BUF$(I),"THEN ")+5 'IF T=5 THEN T=INSTR(T0,BUF$(I),"then")+5     :IF T>5 THEN IFE=TRUE
  168. 8700 IF T=5 THEN T=LEN(BUF$(I))
  169. 8750 IF T=LEN(BUF$(I)) THEN 8950
  170. 8800 IF NOT FNUM(MID$(BUF$(I),T)) THEN 8950
  171. 8850 R$="GOTO "     'IF IFE THEN R$=":GOTO "
  172. 8900 BUF$(I)=LEFT$(BUF$(I),T-1)+R$+MID$(BUF$(I),T):Q=T
  173. 8950 E=INSTR(T,BUF$(I),"ELSE ")+5:IF T=LEN(BUF$(I)) AND E=5 THEN 9400
  174. 9000 IF Q=0 THEN 9400
  175. 9050 N=INSTR(Q,BUF$(I)," ")+1
  176. 9100 M!=VAL(MID$(BUF$(I),N)):IF M!=0 THEN 9400
  177. 9150 FOR K=1 TO IREF:IF REFLIN!(K)=M! THEN 9300:NEXT
  178. 9200 IREF=IREF+1:REFLIN!(IREF)=M!
  179. 9250 JREF=JREF+1:REFER!(JREF)=LINEO!
  180. 9300 NN=INSTR(N,BUF$(I),",")+1:IF NN>N+1 THEN N=NN:GOTO 9100
  181. 9350 IF E>5 THEN T=E:GOTO 8750
  182. 9400 NEXT I
  183. 9450 RETURN
  184. 9500 FOR K=1 TO 4
  185. 9550 FOR I=1 TO LLINES
  186. 9600 P=1
  187. 9650 P=INSTR(P+1,BUF$(I),TST$(K)):IF P=0 THEN 10950
  188. 9700 T$="":FOR J=P-1 TO 1 STEP -1:X$=MID$(BUF$(I),J,1)
  189. 9750 IF(INSTR("=, +*/\()^:<>;-",X$)<>0) THEN 9900
  190. 9800 T$=X$+T$
  191. 9850 NEXT J
  192. 9900 TOKEN$=T$+TST$(K):IF LEN(TOKEN$)=1 THEN 9650
  193. 9950 IF LEN(TOKEN$)>=8 THEN 10000 ELSE TOKEN$=TOKEN$+" ":GOTO 9950
  194. 10000 GOSUB 6900:IF S<>0 AND TOKEN$=KBAS$(PNTR(S)) THEN P=P+1:GOTO 9650
  195. 10050 P=P+1
  196. 10100 ON K GOTO 10150,10350,10500,10700
  197. 10150 REM ALPHA
  198. 10200 FOR N=1 TO IALPH:IF T$=VALPH$(N) THEN 10650
  199. 10250 NEXT
  200. 10300 IALPH=IALPH+1:VALPH$(IALPH)=T$:GOTO 10650
  201. 10350 FOR N=1 TO IINT:IF T$=VINT$(N) THEN 10650
  202. 10400 NEXT
  203. 10450 IINT=IINT+1:VINT$(IINT)=T$:GOTO 10650
  204. 10500 FOR N=1 TO IDBL:IF T$=VDBL$(N) THEN 10650
  205. 10550 NEXT
  206. 10600 IDBL=IDBL+1:VDBL$(IDBL)=T$:GOTO 10650
  207. 10650 GOTO 9650
  208. 10700 REM single
  209. 10750 FOR N=1 TO ISNGL:IF T$=VSNGL$(N) THEN 10900
  210. 10800 NEXT
  211. 10850 ISNGL=ISNGL+1:VSNGL$(ISNGL)=T$:GOTO 10900
  212. 10900 GOTO 9650
  213. 10950 NEXT I
  214. 11000 NEXT K
  215. 11050 RETURN
  216. 11100 TP=0
  217. 11150 FOR K=1 TO 10
  218. 11200 P=1
  219. 11250 P=INSTR(P,BUF$(0),DELIM$(K)):IF P=0 THEN P=LEN(BUF$(0))+1
  220. 11300 T$="":FOR J=P-1 TO 1 STEP -1:X$=MID$(BUF$(0),J,1)
  221. 11350 IF(INSTR("=, +*/\()^:<>;-",X$)<>0) THEN 11500
  222. 11400 T$=X$+T$
  223. 11450 NEXT J
  224. 11500 TOKEN$=T$  'TOKEN$=T$+TST$(K)
  225. 11550 IF LEN(TOKEN$)>=8 THEN 11600 ELSE TOKEN$=TOKEN$+" ":GOTO 11550
  226. 11600 GOSUB 6900:IF S=0 OR TOKEN$<>KBAS$(PNTR(S)) THEN P=P+1:IF P<=LEN(BUF$(0))       THEN 11250 ELSE 11700
  227. 11650 TP=TP+1:TOKLST$(TP)=TOKEN$:AA(TP)=P-(J-1):BB(TP)=P:PTLST(TP)=PNTR(S):P=P+1      :IF P<=LEN(BUF$(0)) THEN 11250 ELSE 11750
  228. 11700 NEXT K
  229. 11750 FOR K=1 TO TP-1:FOR J=K+1 TO TP
  230. 11800 IF AA(J)>AA(K) THEN SWAP AA(J),AA(K):SWAP BB(J),BB(K):SWAP TOKLST$(J),          TOKLST$(K):SWAP PTLST(J),PTLST(K)
  231. 11850 NEXT J:NEXT K
  232. 11900 RETURN
  233. 11950 FOR I=1 TO LLINES
  234. 12000 LNO!=LINEO!+I-1:L2=LEN(BUF$(I))
  235. 12050 IF MID$(BUF$(I),FC,4)<>"FOR " THEN 12300
  236. 12100 PT4=PT4+1:POINT4!(PT4,1)=LNO!:POINT4!(PT4,2)=-PT4:SP=SP+1:STACK4(SP)=PT4
  237. 12150 IF SP<0 THEN ERROR 80 ELSE IF SP>25 THEN ERROR 81
  238. 12200 IF I=1 THEN 12300 ELSE L$=MID$(STR$(LNO!),2)
  239. 12250 GOSUB 20850:GOTO 12450
  240. 12300 IF MID$(BUF$(I),FC,5)="NEXT " OR (L2=FC+3 AND MID$(BUF$(I),FC,4)="NEXT")        THEN POINT4!(STACK4(SP),2)=LNO!:SP=SP-1 ELSE 12450
  241. 12350 IF I=1 THEN 12450 ELSE L$=MID$(STR$(LNO!),2)
  242. 12400 GOSUB 20850
  243. 12450 REM WHILE/WEND
  244. 12500 IF MID$(BUF$(I),FC,6)<>"WHILE " THEN 12750
  245. 12550 PT4=PT4+1:POINT4!(PT4,1)=LNO!:POINT4!(PT4,2)=-PT4:SP=SP+1:STACK4(SP)=PT4:       CSTK$(SP)=MID$(BUF$(I),FC+6)
  246. 12600 IF SP<0 THEN ERROR 80 ELSE IF SP>25 THEN ERROR 81
  247. 12650 IF I=1 THEN 12750 ELSE L$=MID$(STR$(LNO!),2)
  248. 12700 GOSUB 20850:GOTO 12900
  249. 12750 IF MID$(BUF$(I),FC,5)="WEND " OR (L2=FC+3 AND MID$(BUF$(I),FC,4)="WEND")        THEN POINT4!(STACK4(SP),2)=LNO!:BUF$(I)=BUF$(I)+" "+CSTK$(SP):SP=SP-1 ELSE      12900
  250. 12800 IF I=1 THEN 12900 ELSE L$=MID$(STR$(LNO!),2)
  251. 12850 GOSUB 20850
  252. 12900 NEXT I
  253. 12950 RETURN
  254. 13000 IF ERR=80 THEN PRINT"NEXT OR WEND WITHOUT FOR OR WHILE IN: ":PRINT BUF$(0)      :STOP
  255. 13050 IF ERR=81 THEN PRINT"TOO MANY NESTED LOOPS AT: ":PRINT BUF$(0):STOP
  256. 13100 IF ERR=82 THEN PRINT"FOR WITHOUT NEXT SOMEWHERE IN PROGRAM...":STOP
  257. 13150 PRINT ERR,ERL:STOP
  258. 13200 IF IALPH>0 THEN PRINT#2,"      CHARACTER*127 ";
  259. 13250 QL=7:CON=FALSE:FOR I=1 TO IALPH-1:QL=QL+LEN(VALPH$(I))+2
  260. 13300 IF QL<66 THEN PRINT#2,VALPH$(I)+"$"+","; ELSE QL=7:CON=TRUE:PRINT#2,            VALPH$(I)+"$"
  261. 13350 IF CON THEN PRINT#2,"     &";:CON=FALSE
  262. 13400 NEXT I:IF IALPH>0 THEN PRINT#2,VALPH$(IALPH)+"$"
  263. 13450 IF IINT>0 THEN PRINT#2,"      INTEGER ";
  264. 13500 QL=7:CON=FALSE:FOR I=1 TO IINT-1:QL=QL+LEN(VINT$(I))+2
  265. 13550 IF QL<66 THEN PRINT#2,VINT$(I)+"%"+","; ELSE QL=7:CON=TRUE:PRINT#2,             VINT$(I)+"%"
  266. 13600 NEXT I:IF IINT>0 THEN PRINT#2,VINT$(IINT)+"%"
  267. 13650 IF IDBL>0 THEN PRINT#2,"      REAL*8 ";
  268. 13700 QL=7:CON=FALSE:FOR I=1 TO IDBL-1:QL=QL+LEN(VDBL$(I))+2
  269. 13750 IF QL<66 THEN PRINT#2,VDBL$(I)+"#"+","; ELSE QL=7:CON=TRUE:PRINT#2,             VDBL$(I)+"#"
  270. 13800 NEXT I:IF IDBL>0 THEN PRINT#2,VDBL$(IDBL)+"#"
  271. 13850 IF ISNGL>0 THEN PRINT#2,"      REAL ";
  272. 13900 QL=7:CON=FALSE:FOR I=1 TO ISNGL-1:QL=QL+LEN(VSNGL$(I))+2
  273. 13950 IF QL<66 THEN PRINT#2,VSNGL$(I)+"#"+","; ELSE QL=7:CON=TRUE:PRINT#2,            VSNGL$(I)+"!"
  274. 14000 NEXT I:IF ISNGL>0 THEN PRINT#2,VSNGL$(ISNGL)+"!"
  275. 14050 IF EQVFLG THEN PRINT#2,"      LOGICAL FEQV"
  276. 14100 IF XORFLG THEN PRINT#2,"      LOGICAL FXOR"
  277. 14150 IF IMPFLG THEN PRINT#2,"      LOGICAL FIMP":PRINT#2,"      FIMP(X,Y)=((X .AND. Y) .OR. ((.NOT. X) .AND. Y))"
  278. 14200 IF XORFLG THEN PRINT#2,"      FXOR(X,Y)=((X .OR Y) .AND. (.NOT. (X .AND. Y)))"
  279. 14250 IF EQVFLG THEN PRINT#2,"      FEQV(X,Y)=((X .AND. Y) .OR. (.NOT. X) .AND. (.NOT. Y))
  280. 14300 RETURN
  281. 14350 L=LEN(BUF$(0))
  282. 14400 GOSUB 11100
  283. 14450 FOR IT=1 TO TP
  284. 14451 RW=CSRLIN:CL=POS(0)
  285. 14452 LOCATE 25,1:PRINT SPACE$(78);
  286. 14453 LOCATE 25,1:COLOR 6,0:PRINT MID$(BUF$(0),7);:LOCATE 25,70:COLOR 2,0:PRINT       TIME$;
  287. 14454 LOCATE RW,CL
  288. 14500 A=AA(IT):B=BB(IT):TOKEN$=TOKLST$(IT):P=PTLST(IT)
  289. 14550 IF TOKEN$<>KBAS$(P) THEN S=0:GOTO 18200
  290. 14600 IF P>23 THEN 14800
  291. 14650 REM 1 TO 23
  292. 14700 ON P GOSUB 15200,15250,15250,15250,15300,15250,15250,15250,19000,               15350,15200,15200,15250,15250,15150,17750,17750,17750,15250,15250,15250,        15200,15200
  293. 14750 GOTO 15650
  294. 14800 IF P>57 THEN 15000
  295. 14850 REM 24 TO 57
  296. 14900 ON P-23 GOSUB 21800,15200,15250,15150,15950,15200,17250,19200,21600,            15200,31000,15400,15200,15200,15150,15250,15200,21750,19050,15250,17350,        16350,15200,15250,15250,17850,15200,15200,15200,15200,15250,15200,15200,        15200
  297. 14950 GOTO 15650
  298. 15000 IF P>71 THEN ERROR 89
  299. 15050 ON P-57 GOSUB 15250,15250,15200,18300,15200,15250,15800,15250,15200,            18600,19050,15250,17850,21700
  300. 15100 GOTO 15650
  301. 15150 BUF$(0)=FNREP$(BUF$(0),"",A,B):RETURN
  302. 15200 RETURN
  303. 15250 BUF$(0)=FNREP$(BUF$(0),KFOR$(P),A,B):RETURN
  304. 15300 BUF$(0)=LEFT$(BUF$(0),6)+"WRITE(*,*) CHAR(7)":RETURN
  305. 15350 REM CLS:RETURN
  306. 15351 RETURN
  307. 15400 REM INPUT#
  308. 15401 R$=MID$(BUF$(0),B+2)
  309. 15450 Q$=MID$(BUF$(0),B):Z7=VAL(MID$(BUF$(0),B)):BUF$(0)=LEFT$(BUF$(0),A-1)+         "READ("
  310. 15500 X$=STR$(Z7):BUF$(0)=BUF$(0)+X$+")"+R$:RETURN
  311. 15550 REM WRITE#
  312. 15600 RETURN
  313. 15650 NEXT IT
  314. 15700 GOSUB 20900
  315. 15750 RETURN
  316. 15800 X$=KFOR$(P)+CHR$(13)+CHR$(10)+"      "
  317. 15850 IF FNUM(MID$(BUF$(0),B+1)) THEN X$=X$+"GOTO "
  318. 15900 BUF$(0)=FNREP$(BUF$(0),X$,A,B):RETURN
  319. 15950 REM FOR
  320. 16000 IF MID$(BUF$(0),FC,4)="OPEN" THEN RETURN
  321. 16050 FOR J=1 TO PT4:K=J:IF POINT4!(J,1)=LINEO! THEN 16200
  322. 16100 NEXT J
  323. 16150 PRINT"error":STOP
  324. 16200 X$=STR$(POINT4!(K,2)):X$="DO"+X$
  325. 16250 BUF$(0)=FNREP$(BUF$(0),X$,A,B)
  326. 16300 RETURN
  327. 16350 ACC$=",ACCESS="+CHR$(34)+"SEQUENTIAL"+CHR$(34):RL$=""
  328. 16400 FM=1:IF INSTR(BUF$(0),",")<>0 THEN 16850
  329. 16450 FS=INSTR(FC,BUF$(0)," "):S2=INSTR(FS+1,BUF$(0)," ")
  330. 16500 NAM$=MID$(BUF$(0),FS+1,S2-FS-1)
  331. 16550 P3=INSTR(BUF$(0),"#"):IF P3=0 THEN P3=INSTR(BUF$(0)," AS ")+3
  332. 16600 FIL=VAL(MID$(BUF$(0),P3+1))
  333. 16650 P4=INSTR(BUF$(0),"="):IF P4=0 THEN 16750
  334. 16700 RL$=",RECL="+STR$(VAL(MID$(BUF$(0),P4+1))):ACC$=",ACCESS="+CHR$(34)+            "DIRECT"+CHR$(34)
  335. 16750 BUF$(0)="      OPEN("+STR$(FIL)+",FILE="+NAM$+",STATUS="+CHR$(34)+"OLD"+        CHR$(34)+ACC$+RL$+")"
  336. 16800 RETURN
  337. 16850 P1=INSTR(FC,BUF$(0),","):P2=INSTR(P1+1,BUF$(0),",")
  338. 16900 P3=INSTR(P2+1,BUF$(0),","):IF P3=0 THEN P3=LEN(BUF$(0))
  339. 16950 NAM$=MID$(BUF$(0),P2+1,P3-P2-1)
  340. 17000 P4=INSTR(BUF$(0),"#"):IF P4=0 THEN P4=P1
  341. 17050 FIL=VAL(MID$(BUF$(0),P4+1))
  342. 17100 IF P3<LEN(BUF$(0)) THEN RL$=",RECL="+STR$(VAL(MID$(BUF$(0),P3+1))):ACC$=        ",ACCESS="+CHR$(34)+"DIRECT"+CHR$(34)
  343. 17150 GOTO 16750
  344. 17200 RETURN
  345. 17250 REM GOTO
  346. 17300 RETURN
  347. 17350 REM ON
  348. 17400 BL(1)=INSTR(FC,BUF$(0)," ")
  349. 17450 FOR M=2 TO 3:BL(M)=INSTR(BL(M-1)+1,BUF$(0)," "):NEXT
  350. 17500 IF MID$(BUF$(0),BL(2)+1,BL(3)-BL(2)-1)<>"GOTO" THEN RETURN
  351. 17550 X$=MID$(BUF$(0),BL(1)+1,BL(2)-BL(1)-1)
  352. 17600 Y$="("+MID$(BUF$(0),BL(3)+1)+") "
  353. 17650 BUF$(0)="      GOTO "+Y$+X$:RETURN
  354. 17700 RETURN
  355. 17750 REM DEF---
  356. 17800 GOSUB 15250:BUF$(0)=BUF$(0)+")":RETURN
  357. 17850 REM PRINT#
  358. 17900 P2=INSTR(BUF$(0),","):P1=INSTR(BUF$(0),"#"):FIL$=STR$(VAL(MID$(BUF$(0),         P1+1,P2-P1-1)))
  359. 17950 FIL$=MID$(FIL$,2)
  360. 18000 BUF$(0)=FNREP$(BUF$(0),"WRITE("+FIL$+",*)",FC,P2+1)
  361. 18050 RETURN
  362. 18100 REM
  363. 18150 RETURN
  364. 18200 REM SPECIAL ACTION
  365. 18250 GOTO 15650
  366. 18300 P1=INSTR(FC,BUF$(0)," "):P2=INSTR(BUF$(0),",")
  367. 18350 X$=MID$(BUF$(0),P1+1,P2-P1-1):Y$=MID$(BUF$(0),P2+1)
  368. 18400 Z$="TEMP$$="+X$+CHR$(13)+CHR$(10)+"      "+X$+"="+Y$
  369. 18450 Z$=Z$+CHR$(13)+CHR$(10)+"      "+Y$+"="+"TEMP$$"
  370. 18500 BUF$(0)=LEFT$(BUF$(0),6)+Z$:RETURN
  371. 18550 RETURN
  372. 18600 REM WEND
  373. 18650 BUF$(0)=FNREP$(BUF$(0),"IF(",A,B):GOSUB 19300
  374. 18700 FOR J=1 TO PT4:K=J:IF POINT4!(J,2)=LINEO! THEN 18850
  375. 18750 NEXT J
  376. 18800 PRINT"ERROR":STOP
  377. 18850 X$=STR$(POINT4!(K,1))
  378. 18900 BUF$(0)=BUF$(0)+")"+" GOTO "+X$
  379. 18950 RETURN
  380. 19000 GOSUB 15250:BUF$(0)=BUF$(0)+")":RETURN
  381. 19050 BUF$(0)=LEFT$(BUF$(0),6)+"CONTINUE"
  382. 19150 I=0:GOSUB 20850:RETURN
  383. 19200 REM
  384. 19250 GOSUB 15250:IFFLG=TRUE
  385. 19300 M=0:D=INSTR(BUF$(0),"ELSE"):IF D=0 THEN D=LEN(BUF$(0))
  386. 19350 M=M+1:IF M>D THEN 20750
  387. 19400 IF MID$(BUF$(0),M,1)="]" THEN IFFLG=FALSE:MID$(BUF$(0),M,1)=")"
  388. 19450 P=INSTR("<>=",MID$(BUF$(0),M,1))
  389. 19500 IF MID$(BUF$(0),M,3)="IF(" THEN IFFLG=TRUE
  390. 19550 IF P=0 OR NOT IFFLG THEN 19350
  391. 19600 MM=M+1
  392. 19650 Q=INSTR("<>=",MID$(BUF$(0),MM,1)):IF Q=0 THEN MM=M
  393. 19700 R=4*Q+P:ON R+1 GOTO 20650,19750,19900,20050,20650,20650,20200,20350,20650,      20200,20650,20500,20650,20350,20500,20650
  394. 19750 REM <
  395. 19800 BUF$(0)=FNREP$(BUF$(0),".LT.",M,MM+1)
  396. 19850 M=MM+2:GOTO 19400
  397. 19900 REM >
  398. 19950 BUF$(0)=FNREP$(BUF$(0),".GT.",M,MM+1)
  399. 20000 M=MM+2:GOTO 19400
  400. 20050 REM =
  401. 20100 BUF$(0)=FNREP$(BUF$(0),".EQ.",M,MM+1)
  402. 20150 M=MM+2:GOTO 19400
  403. 20200 REM <>
  404. 20250 BUF$(0)=FNREP$(BUF$(0),".NE.",M,MM+1)
  405. 20300 M=MM+2:GOTO 19400
  406. 20350 REM <=
  407. 20400 BUF$(0)=FNREP$(BUF$(0),".LE.",M,MM+1)
  408. 20450 M=MM+2:GOTO 19400
  409. 20500 REM >=
  410. 20550 BUF$(0)=FNREP$(BUF$(0),".GE.",M,MM+1)
  411. 20600 M=MM+2:GOTO 19400
  412. 20650 REM IMPOSSIBLE...?
  413. 20700 GOTO 19400
  414. 20750 RETURN
  415. 20800 RETURN
  416. 20850 IF VAL(L$)>0 THEN FOR NN=1 TO LEN(L$):MID$(BUF$(I),NN,1)=MID$(L$,NN,1):NEXT NN:RETURN
  417. 20851 RETURN
  418. 20900 REM SEARCH
  419. 20950 FOR J=1 TO IREF:K=J:IF REFLIN!(J)=LINEO! THEN 21100
  420. 21000 NEXT J
  421. 21050 RETURN
  422. 21100 I=0:GOSUB 20850:RETURN
  423. 21150 REM
  424. 21200 L=LEN(BUF$(0))
  425. 21250 I=0
  426. 21300 I=I+1:IF I>L THEN 21550
  427. 21350 X$=MID$(BUF$(0),I,1)
  428. 21400 IF X$=CHR$(34) THEN MID$(BUF$(0),I,1)="'" ELSE IF X$="^" THEN BUF$(0)=          FNREP$(BUF$(0),"**",I,I+1)
  429. 21450 L=LEN(BUF$(0))
  430. 21500 GOTO 21300
  431. 21550 RETURN
  432. 21600 REM IMP
  433. 21650 FUN$=" IMP":FUN2$="FIMP(":GOSUB 21850:RETURN
  434. 21700 FUN$=" XOR":FUN2$="FXOR(":GOSUB 21850:RETURN
  435. 21750 FUN$=" MOD":FUN2$="AMOD(":GOSUB 21850:RETURN
  436. 21800 FUN$=" EQV":FUN2$="FEQV(":GOSUB 21850:RETURN
  437. 21850 REM general
  438. 21900 P=INSTR(BUF$(0),FUN$)
  439. 21950 Y$="":FOR I=P-1 TO 1 STEP -1:X$=MID$(BUF$(0),I,1)
  440. 22000 IF(INSTR("=, +*/\()^:<>;-",X$)<>0) THEN 22100
  441. 22050 Y$=X$+Y$:NEXT I
  442. 22100 R=P+5:FOR Q=R TO LEN(BUF$(0)):X$=MID$(BUF$(0),Q,1)
  443. 22150 IF(INSTR("=, +*/\()^:<>;-",X$)<>0) THEN 22250
  444. 22200 NEXT Q
  445. 22250 X$=")":Z$=MID$(BUF$(0),R,Q-R+1):IF Z$="(" THEN Z$="":X$=""
  446. 22300 BUF$(0)=FNREP$(BUF$(0),FUN2$+Y$+","+Z$+X$,I+1,Q):RETURN
  447. 30000 LOCATE 3,50:COLOR 4,0:PRINT"SOURCE LINES:";Z!
  448. 30001 LOCATE 4,50:COLOR 6,0:PRINT"OUTPUT LINES:";OLIN
  449. 30002 RETURN
  450. 31000 IF MID$(BUF$(0),FC,4)="OPEN" THEN RETURN
  451. 31005 IF MID$(BUF$(0),B+1,1)="#" THEN P=P+1:B=B+2:GOTO 15400
  452. 31100 GOSUB 15250:RETURN
  453.